package Zim::Formats;

# TODO: extensions hahsed in Store::Files
# TODO: hash with aliases from names to modules

use strict;
use constant {
	READ   => 1,	# we can input this format
	WRITE  => 2,	# we can output this format
	NATIVE => 4,	# we can read/write instead of import/export
};
use File::BaseDir qw/xdg_data_home xdg_data_dirs/;

our $VERSION = '0.20';

=head1 NAME

Zim::Formats - Common routines for Zim formats

=head1 DESCRIPTION

TODO

=head1 METHODS

=head2 Registration

=over 4

=cut

our %formats = (
	man  => READ | NATIVE,
	wiki => READ | WRITE | NATIVE,
	html => WRITE,
	txt2tags => WRITE,
);

=item C<register_format()>

TODO

=cut

sub register_format {
	my ($class, $name, $mode, $native) = @_;
	my $mask = ($mode eq 'r')  ? READ  :
	           ($mode eq 'w')  ? WRITE :
		   ($mode eq 'rw') ? READ | WRITE : undef ;
}

=item C<list_formats()>

TODO

=cut

sub list_formats {
	my ($class, $mode, $native) = @_;
	my $mask = ($mode eq 'r') ? READ  :
	           ($mode eq 'w') ? WRITE : undef ;
	die "BUG: unknown mode: $mode" unless defined $mask;
	$mask |= NATIVE if $native;
	return grep { ($formats{$_} & $mask) == $mask } keys %formats;
}

=back

=head2 Using templates

=over 4

=item C<lookup_template(FORMATE, NAME)> 

Returns a file name or undef.

=cut

sub lookup_template {
	my ($class, $format, $name) = @_;
	my $map = $class->list_templates($format);
	return $$map{$name} if exists $$map{$name};
	my ($key) = grep {lc $_ eq lc $name} keys %$map;
	return $$map{$key} if defined $key;
	return undef;
}

=item C<list_templates(FORMAT)>

Returns a hash with name => filename pairs of available templates.
Used for exporting.

TODO: also look in repository/_templates/

=cut

sub list_templates {
	my ($class, $format) = @_;
	$format = lc $format;

	my %templates;
	for (xdg_data_home(), xdg_data_dirs()) {
		my $dir = File::Spec->catdir($_, 'zim', 'templates', $format);
		next unless -d $dir;
		for my $f (Zim::File->list_dir($dir)) {
			$f =~ /(.*?)(\.|$)/;
			$templates{$1} = "$dir/$f"
				unless defined $templates{$1};
		}
	}

	return \%templates;
}


=item C<bootstrap_template()>

TODO

=cut

sub bootstrap_template {
	my ($tree, $page, $io, $template, $format);
	# bootstrap template to format
	# Autoload Zim::Template here - no need to depent
	# constantly on it

}

=item C<save_tree(IO, TREE, PAGE)>

TODO

---

When a subclass has defined a C<%Tags> this method
will wrap the text context of each parse-tree node in this tag.

The hash C<%Tags> uses the tag names as keys and has as values
array refs consisting of a start string, a closing string and a
boolean whether this tag can span multiple lines.

For all tags not found in this hash a method C<dump_TAG()> is
called, where TAG is the tag name.

=cut

sub save_tree {
	no strict 'refs';
	my ($class, $io, $tree, $page) = @_;
	my $tags = \%{$class.'::Tags'};

	my $nodes;
	if ($$tree[0] eq 'Page') {
		splice @$tree, 0, 2;
		$nodes = $tree;
	}
	else { $nodes = [ $tree ] }

	$class->_dump_nodes($nodes, $tags, $io, $page, 1);
}

sub _dump_nodes {
	my ($class, $nodes, $tags, $io, $page, $mline) = @_;
	for my $node (@$nodes) {
		unless (ref $node) {
			print {$io} $node;
		}

		my $type = $$node[0];
		if ($$tags{$type}) {

		}
		else {
		}
	}
}

=back

=head2 Parse-tree manipulation

=over 4

=item C<parse_link(LINK, PAGE)>

Returns the link type and link target for LINK. The type can be 'page',
'file', 'mail' or 'man' - for urls the protocol is used as type.

The target returned is usually the same as LINK but can be different
for example for interwiki links.

=cut

sub parse_link {
	my (undef, $link, $page) = @_;
	if ($link =~ m#^(\w[\w\+\-\.]+)\?(.*)#) { # interwiki link
		my $l = Zim->interwiki_lookup($1, $2);
		$link = $l if defined($l);
		# when lookup failed we pass on trough
		# this ensures that things like man?zim will also work
		# in special cases a interwiki may in turn return
		# a "key?page" string, now "key" is the type
	}
	#warn "Parsing link: $link\n";
	
	my $type;
	$_ = $link;
	if    (m#^(\w+[\w\+\-\.]+)://#) { # urls
		$type = $1;
		$link = Zim::File->parse_uri($link) if $type eq 'file';
	}
	elsif (m#^mailto:|^\S+\@\S+\.\w+$#) { # email
		$link =~ s#^(mailto:)?#mailto:#;
		$type = 'mail';
	}
	elsif (m#^(\w[\w\+\-\.]+)\?(.*)#) { # type?string
		($type, $link) = ($1, $2);
	}
	else { $type = (m#/#) ? 'file' : 'page' } # file or page
	
	if ($type eq 'page') {
		$link =~ s#^\.:*#$page:#; # sub-page
		$link = Zim::Store->clean_name($link, 'NOT_ABS');
	}
	elsif ($type eq 'file') {
		if ($link =~ /^\//) { # document root  ( ignores file:// )
			my $root = $page->{root}->config->{file_root} || '';
			$link = $root . $link;
		}
		$link = Zim::File->abs_path(
			$link, $page->{properties}{base} );
	}

	return $type, $link;
}


=item C<extract_refs(TYPE, TREE)>

Returns a list with references to nodes of type TYPE in the tree.

=cut

sub extract_refs { # returns references to nodes of type TYPE
	my ($class, $type, $tree) = @_;
	my @nodes;
	for (2 .. $#$tree) {
		my $node = $$tree[$_];
		next unless ref $node;
		push @nodes, ($$node[0] eq $type)
			? $node : $class->extract_refs($type, $node) ; # recurs
	}
	return grep defined($_), @nodes;
}

=item C<delete_first(TYPE, TREE)>

Deletes and returns the first node of type TYPE from the tree.

=cut

sub delete_first {
	my ($class, $type, $tree) = @_;
	for my $i (2 .. $#$tree) {
		next unless ref $$tree[$i];
		return splice @$tree, $i, 1 if $$tree[$i][0] eq $type;
		my $r = $class->delete_first($type, $$tree[$i]); # recurs
		return $r if $r;
	}
	return undef;
}

=item C<get_first_head(TREE, STRIP)>

Returns the level and the text content of the first head.

STRIP is a boolean, if set to TRUE the head is removed from the tree.

=cut

sub get_first_head {
	my ($class, $tree, $strip) = @_;
	# remove empty paragraphs from begin of tree ?
	return unless ref $$tree[2] and $$tree[2][0] =~ /^head/;
	my $title = $strip ? splice(@$tree, 2, 1) : $$tree[2];
	$$title[0] =~ /^head(\d+)/;
	my $lvl = $1;
	$title = join '', @$title[2 .. $#$title];
	return ($lvl, $title);
}

=item C<update_heads(TREE, MIN, MAX)>

Given a parse tree this method updates the level of all headings.
MIN is the minimum level, so all headings will be shifted down with
this amount (default is 1).
MAX is the max level, any heading below this level will be flattened
to the maximum level (default is undefined).

It is assumed that heads can only occur toplevel in the parse tree.
(They can not be nested indside paragraphs etc.)

=cut

sub update_heads {
	my ($class, $tree, $min, $max) = @_;
	$min ||= 1;
	$min -= 1;
	for (2 .. $#$tree) {
		next unless ref $$tree[$_] and $$tree[$_][0] =~ /^head/;
		$$tree[$_][0] =~ /^head(\d+)/;
		my $lvl = $1;
		$lvl += $min;
		$lvl = $max if $max and $lvl > $max;
		$$tree[$_][0] = 'head'.$lvl;
	}
}

=item C<fix_file_ending(TREE)>

Make sure that the last piece of text in the tree ends
with a newline. This increases the change of the file
resulting from dumping the tree to end in a newline.

=cut

sub fix_file_ending {
	my $tree = pop;
	my $l = $tree;
	while (@$l > 2) {
		if (ref $$l[-1]) {
			if ($$l[-1][0] =~ /^[A-Z]/) { $l = $$l[-1] }
			else {
				push @$l, "\n";
				last;
			}
		}
		else {
			#warn "Last element was $$l[0]\n";
			#warn ">>>$$l[-1]<<\n";
			$$l[-1] =~ s/\n?$/\n/;
			last;
		}
	}
	# We assume multi-line blocks a name
	# that starts with a capital, like 'Param'.
	# We assume nodes without content to be objects
	# like images.
}

1;

__END__

=back

=head1 AUTHOR

Jaap Karssenberg (Pardus) E<lt>pardus@cpan.orgE<gt>

Copyright (c) 2006 Jaap G Karssenberg. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 SEE ALSO

L<Zim>

=cut

